home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / Float source / fInterpret < prev    next >
Text File  |  1994-06-24  |  2KB  |  73 lines
  1. \ fInterpret -- Replaces INTERPRET; provides interpretation of floats
  2. \  5/11/85  ssg Version 1.0  
  3. \  9/19/85  cbd Modified for floating point heap.
  4. \  8/16/86  cdn Replace setupFP with FPinit
  5. \  5/27.92    rfl    moved fpmodel stuff from fval to here; need finterpret running
  6.  
  7. \ scans str255 for decimal
  8. :code scan ( addr -- b)
  9.     move.l    (sp),a0
  10.     adda.l    a3,a0
  11.     clr.l    d7
  12.     move.b    (a0)+,d7
  13.     subq.w    #1,d7
  14. j1    cmpi.b    #46,(a0)+
  15.     beq        out
  16.     dbra    d7,j1
  17.     clr.l    d0
  18.     bra        bye
  19. out    moveq.l    #1,d0
  20. bye    move.l    d0,(sp)
  21. ;code
  22.  
  23. ( addr -- flt t OR f) \ Attempts to convert token at addr to a float.
  24. : fnumber  { addr -- flt t OR f }
  25.     addr scan IF addr atof: floati/o ELSE false THEN ;
  26.  
  27. \ Write a float into dictionary: analogous to , or c, .
  28. \ ( flt -- )
  29. \ : f,   dup 2+ here 10 cmove 10 allot fdrop    ;
  30.  
  31. ( b flt -- )      \ Compiles an in-line float 
  32. : fLiteral  state IF compile flit f, ELSE swap THEN   ; immediate
  33.  
  34.  
  35. ( -- b) \ True means string at here is a float.
  36. : fFind     here fnumber dup          
  37.             IF  swap [compile] fLiteral THEN   ; 
  38.  
  39. ( -- )      \ Adds ability to interpret floats to INTERPRET.
  40. : fInterpret
  41.         BEGIN find
  42.               IF    state  <
  43.                     IF  cfa ,  ELSE cfa execute THEN
  44.                ELSE  fFind not           \ fFind returns true if float found.
  45.                     IF  here number dpl 1+
  46.                         IF      [compile] dliteral
  47.                         ELSE    drop [compile] literal
  48.                         THEN
  49.                     THEN
  50.               THEN  ?stack ?dp
  51.         AGAIN   ;
  52.  
  53. \ store this word in OBJINIT to start up with float enabled
  54. : FPinit   init: floatI/O init: fltMem ;
  55.  
  56. \ new error handler for use with floating point extensions
  57. : cleanFloat  clean2  init: fltMem  ;
  58.  
  59. \ Install finterpret as the new INTERPRET.
  60. : yerk>flt  'c finterpret -> interpret
  61.             'c cleanFloat -> abortVec ;
  62.  
  63. \ Install INTERPRET in nucleus, disabling floating-pt parsing
  64. : yerk>int  0 -> interpret
  65.             'c yerk -> objInit
  66.             'c clean2 -> abortVec ;
  67.  
  68. yerk>flt
  69.  
  70. 0. fvalue fpmodel
  71.  
  72. 'code fpmodel -> fvalcode       \ patch value in Args file
  73.